RESPC.OLD[MSS,LCS]3 - www.SailDart.org

perm filename RESPC.OLD[MSS,LCS]3 blob sn#252832 filedate 1976-12-01 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE RESPC
C00014 ENDMK
C⊗;
	SUBROUTINE RESPC
	COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
	1 /IPG/IPG,JPG,BRACK,RSTNUM(8),RPSZ(8),RHGT(8),
	1 RCLEF(-3/4) /IVV/IV(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
	COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
	1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),
	1 KPN(1),RSIG(-3/4),RMETER(-3/4),RCL(-3/4)
	COMMON /PX/PN(1) /Q/Q(1)
	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
	1 /KBAR/KBAR(512) 
	1 /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
	DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
	1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/
C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
	1,(MM,RN),(NN,RN(1501)),(KPN,PN),(KS,RS),(BARS,KBAR(4))
	1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
	1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46))
C  RQ(2) IS R4, RQ(3) IS R5 ETC.

	SPCNT=1.0
	JX=0
	XT=0
	PX=0
	CALL SHFT1(KQ)
	KK=L
CC	TYPE 3001,L
C  DELETES EXTRA BAR LINES, ETC.
	IF(IPG)CALL RESTS
C  FROM NKW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
	CALL SHIFT
C  L=NUMBER OF ITEMS FOR RHY RECONS.
	N=0
	S=-100
	R=0
	KCLEF=0

	DO 601 K=1,L
	R=CODEN(KPN,K,Q,J)
CX	J=KPN(K)
CC	N=N+1
CC	NN(N)=0
CC	MM(N)=J+3
	CALL MMNN(3)
CX	R=Q(J+1)
801	IF(R.NE.1)GO TO 1801
	IF(Q(J+8).EQ.1000)GO TO 601
C  SKIP SLASHED GRACE NOTE. *****
	GO TO 702
1801	IF(R.LT.4)GO TO 702
	IF(R.EQ.17)GO TO 702
	IF(R.EQ.18)GO TO 1702
	IF(R.LE.7)GO TO 30
	IF(R.NE.44)GO TO 601
	IF(Q(J+6).EQ.0)GO TO 601
	IF(Q(J+5).EQ.0)GO TO 601
C  GETS LEFT END OF LINES, CRESC., DASHES.
	GO TO 604
30	IF(R.NE.7)GO TO 605
	IF(Q(J).LT.5)GO TO 604
C JUMP FOR STANDARD TRILL
	RS=RN(J+7)
	IF(RS.EQ.1)GO TO 604
	IF(ABS(RS).GE.3)GO TO 604
C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
	GO TO 601
605	IF(R.NE.4)GO TO 604
	IF(Q(J).EQ.2)GO TO 702
C JUMP IF IT IS A BAR LINE
	IF(Q(J).LT.4)GO TO 601
	IF(Q(J+6).NE.0)GO TO 604
C GO GET OTHER POS OF LINE
	GO TO 601
1702	IF(Q(J+4).NE.0)GO TO 601
C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
702	NN(N)=R 
	GO TO 601
C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
604	CALL MMNN(6)
C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
	IF(R.NE.6)GO TO 601
C NEXT FOR BEAMS
	RZ=Q(J)
	IF(RZ.LT.8)GO TO 608
	IF(Q(J+10).EQ.0)GO TO 608
	IF(Q(J+7).GT.0)CALL MMNN(8)
C NEXT SHIFTS P8 OF COMPOSITE BEAMS
608	IF(RZ.LT.7)GO TO 601
	IF(Q(J+7))GO TO 688
C  P7 IS NEG FOR TREMOLO
	IF(Q(J+8).EQ.0)GO TO 601
C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
688	IF(Q(J+9).GT.0)CALL MMNN(9)
C FOUND A POS. IN P9
601	CONTINUE

C NEXT SORTS THE POINTS
6000	J=1
610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
	CALL EXCHG(MM(J),NN(J))
C  ABOVE EXCHGS --(J) AND --(J+1)
	IF(J.EQ.1)GO TO 710
	J=J-1
	GO TO 610
710	J=J+1
	IF(J.LT.N)GO TO 610
C NOW ALL SORTED

	K=0
	IF(NMPG.NE.'PAGEA')GO TO 2703
	KLEF=0 
CARES ABOUT CLEFS ONLY AT VERY FIRST.
	RNEXT=0
C  FOR METER AT END OF BAR
2703	K=K+1
	M=NN(K)
	IF(M.EQ.0)GO TO 703
	S=Q(MM(K))
C POS OF THIS ITEM
        KW=K
	IF(M.LT.3)GO TO 1703
	RZ=.8
	IF(M.NE.3)GO TO 4703
7777	IF(KLEF)GO TO 5703
C LOOK AT CLEFS ONLY ONCE.
	KLEF=-1
4703	KW=KW+1
	IF(KW.GT.N)GO TO 703
	IF(NN(KW).EQ.0)GO TO 4703
	RT=Q(MM(KW))-S
C  SPACE BETWEEN THIS AND NEXT ITEM
	IF(RT.GT.RZ)GO TO 703
	NN(KW-1)=0
	K=KW
	GO TO 4703
5703	NN(K)=0
	GO TO 703
1703	KW=KW+1
	IF(KW.GT.N)GO TO 703
	RT=Q(MM(KW))-S
C  SPACE BETWEEN THIS AND NEXT ITEM
	IF(RT.LT.SPCNT)GO TO 1703
7703	IF(KW-K.EQ.1)GO TO 703
	KW=KW-1
	IF(NN(KW).EQ.0)GO TO 7703
8703	DO 6703 J=K,KW-1
	M=NN(J)
	IF(M.GT.2)M=0
6703	NN(J)=-M
C FOR ITEMS BETWEEN 2 POINTS, CHANGES 1,2 TO -1,-2; OTHERS TO 0.
	K=KW
703	IF(K.LT.N)GO TO 2703

	J=0
1710	J=J+1
	IF(NN(J).LE.0)GO TO 1710
C FIND 1ST IMPORTANT ITEM.  PUT POS IN S2 AND P1
	S2=Q(MM(J))
	P1=S2


612	IF(NN(J).EQ.0)GO TO 613
7102	M=J+1
	S1=S2
	LS=0
616	IF(NN(M).GT.0)GO TO 614~∀%∪Q~9"]≤%∂≡A)<@lbh4∀blbX∪~{~,b~∃ε↓~A/∪1_A!∨%≥(A)<A≥1PA∪≠!=%)β≥PA∪)4\~∀∪≥≡A)≡lbl~)εAβ'M+≠&↓!%∨!∃$A≥⊂A∨A1∪'(~(lbh∪1&{∀~)εA→&↓≠+'(↓%≠β%≤A)⊃∀A'β≠∀A/⊃8Aπ⊃∨IλA≥∨Q&A
=+≥λ\4∀∪↔.u∀~∀bXbh∪⊗u≠~Q∀$~∀∪%h{"Q⊗$~∀nb@h∪${DQ⊗Zd$~∃εAQ⊃
Aπ=	
@F4∀∪∪!$]∂(8dS∂≡↓)≡@lDp~∀∪I(zr[HTd~∀% {"Q,W∪
∪`Q%(R4bR~∀%∪Q"!⊗ZfR9→(]%PS zb@`\`~)εA/βLA)⊃I
AαAI⊃3)⊂↓-β→+∀}~∀∪%Q ]1(\bS≥≡A)≡l`l~(∪∪Q9≤Q~R9"\h%∂≡A)<@l`l4∃εAπU(A	∨]≤A'!¬π
Aβ→)$AE+β%)∃$A∨$↓∂%βQ$A∪_A≥1PA∪&@LXbnXDp~∀∪%Q≥≤!~R]∂P\dS u ↑d~(l`l∪%Q ]9
\`S≥≡A)≡ll`l4∃εAπ¬)π⊂A
⊃∨%λ↓≥∨)L@ZZAQ⊃≤A	βπ⊗AU A)≡↓
∪≥λ↓%⊃3) \A-β0\~∀∪({∀Zb4∀∪∂≡↓)≡@bXbh~∀Xl`l∪%Q1(9"\`%∂≡A)<@fl`X~∀∪0u ~∀∪%Qβ¬LQ1([@R]→(8\`bS≥≡A)≡hl`l4∃ε@A→∨$A%=+≥	∨→A!%=¬→≠LA/∪) A)%∪A→)&0A)ε8~∀∪∪_Q ]→P]1(S≥≡A)≡dl`l4∀hl`X∪ {1P~∃ε@↓
∨$A9∨≤[π=∪≥π∪⊃≥)β0A%⊃3Q⊃≠&~(@∪1(u0[ ~(∪∂≡AQ≡@fl@l~∀dX`l∪1P{1([@~∀~∀Ll`l∪%Qβ¬LQ1(R9→(\\@bS1(t`~∀∪1&{→&4b~∀∪%Q→&9"\`%∂≡A)<@l`n4∃εA≥∃1(Aπ!π↔&↓∨≤Aβ1_A≥¬%¬2AI⊃3)⊃5&~∀∪1α{≠~!→&R~)πε∪∪_Qβ¬&!"Q→α$[%4R9∂(]'Aπ≥(S≥≡A)≡l`n~(∪∪QI4["Q1αR]∂P]'!πI0S∂≡↓)≡@l@n~∀∪%Q≥≤!→&R]≥
\`S≥≡A)≡fl`l4∃εA∂<A¬βπ,A∪A9∨(A≥=)
A∨HA%'P@PbXH@@Zb0ZdR~(∪%({DQ→αZHR~∃π∪∪QI(]∂(8fS∂≡↓)≡@fX`l~∃@A→∨=⊗Aβ(↓≥∨)LAβ≥λ↓%')LA∨≥→d~∀∪∪_Q"Q→∧ZfR]1(\r[I(TdS≥≡A)≡fl`l4∃εA∃U≠ A∪_A≥≡AI⊃3)⊃4A∨≤AQ⊃∪&A9∨)
~(∪→ε{1αVp[I(Td~)εA→ε↓∪&A!¬%β~A→∨$A%!3)⊂A%≤A%M(A∨$↓≥∨)
4∃πε∪%Q"Q1εR]∂∀] S∂<A)≡@Ll`l~)πε∪ u"Q→ε$~∃ε@↓∂)&↓'≠β→1'(AI⊃3)⊃4~∀∪%P{"Q→R~∀∪%Q%(9"\`%∂≡A)<@fl`X~∃εAI(z`A5β≥&↓∪(O&↓αAπ⊃=%λA≥=)
\~)π10∪%Q ]9
\`S≥≡A)≡jl`l4∃π10% {%(4∃π10%∂≡A)<@fl`X~∃πε%∪Q%P]→(]@S {%P~∀jl@l∪∪!β¬&QI([ R9→(\\@bS%(u ~∀∪%Q%(9"] %∂≡A)<@fl`X~∀∪∪_Q%(]1(] S≥≡A)≡bl`l4∃ε@A→∨$A≥N-COINCIDENTAL RHYTHMS
	XT=RT-P
	GO TO 3606
1606	XT=P-RT
	P=RT
	GO TO 3606

607	IF(P.EQ.100)P=1
	IF(R.NE.2)GO TO 615
	IF(P.LT..2)P=.2
C  32ND, 0Q)⊂A%∃')&A≥(A¬%∂∂β$∧~∀lbT∪∪Q)0S∂≡↓)≡@l@r~∀∪%Q ]1(\\bHjS z8bdj~)εA≥∨\A≠∨-∀A-I3)⊃∪9∞A
%=~A∀VDA∨≤\4∀~∀∪≥≡A)≡l`r~(~∃πεXdr∪∪_Q"Q⊗,jR]D\b``β↓&≡=¬"=↓Y≠4*∞_J&→"
B-5MJr≡∃9Brε:⊃u	"--:I:⊗Es	&≡=¬"=↓Y≠4*
αα≡Jε≤)α:>$*MαICiEAA∧∧⎇∩
L&π,#"H8b21E
Qq%eLM*(yh∃∪dεL-c!!"ML'↓21J
%Q4+F54∂-!QB21E
KQ4%`~∀h≡L↔≠εEαdc∀)#bW_MTh≡YKεE∧dQ∀)↔'⊃Vα9)GO TO 628
C  FOR BAR REPEAT SIGN.  =HALF NOTE SPACE
	P=2.
CC630	P=.05
C  FOR GRACE NOTES
CC617	IF(P.EQ.0)P=1
CC	IF(P.LT..125)P=.125
609	IF(P.GT.8)P=8

C********************
	IF(XT.EQ.0.AND.JX.EQ.0)GO TO 2609
	JX=-1
	RX=P
	IF(PX.NE.0)GO TO 3609
	PX=P
CCCCC	IF(P.GT.XT)P=XT
	QX=P
3609	P=QX
	GO TO 1609
2609	PX=0
1609	P=(P+(.125-P)*FIB)*RSPC
	IF(PX.NE.0)P=P*RX/QX
	IF(P.GT.18)P=P-P/7
C  MAKE THIS BETTER!!!!
	IF(XT.NE.0)GO TO 628
	JX=0
	PX=0
628	K=MM(M)
	S2=Q(K)
	P2=P1+P
	Q(K)=P2
	IF(M-KW.EQ.1)GO TO 7103
C NEXT ADJUSTS STUFF IN BETWEEN
	R=P/(S2-S1)

	DO 620 K=KW+1,M-1
	LA=MM(K)
620	Q(LA)=P1+R*(Q(LA)-S1)

7103	P1=P2
	J=M
	IF(J.LT.N)GO TO 7102
613	J=J+1
	IF(J.LT.N)GO TO 612
C  ALL DONE!
C***	IF(XLFT.EQ.0)GO TO 600
C  NEXT MOVES LEFT SIDE OF STAFF TO ZERO
	CALL PUTEXT(NMPG,'PAG')
2929	JJ2=L+2
	LCNT=0
	NDPY=0
	JPQ=KPN(L+1)+1
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(PN,JJ2)
	CALL EXTOUT(Q,JPQ)
	CALL FINEXT
	LASTNM=NMPG
	ENDLN=RNEXT
	DO 12 J=1,L
	LA=KPN(J)
	IF(Q(LA+1).NE.4)GO TO 12
	KBR=KBR+1
C BAR LINE COUNTER
	T=Q(LA+3)
C TOTAL SPACE
CC	R=0
CC	IF(NEXTB.GE.0)GO TO 222
CC	R=5
C  EXTRA SPACE FOR METER FROM END OF PREV. LINE.
CC	NEXTB=0
222	BARS(KBR)=T-ENDLN
C SIZE OF THIS MEASURE
	K=J
	ENDLN=T
12	CONTINUE
	RNEXT=ENDLN
	IF(K.EQ.L)GO TO 122
C  EXTRA SPACE FOR METER FROM END OF PREV. LINE.
CC	NEXTB=-1
	ENDLN=Q(KPN(L)+3)
122	NMPG=NMPG+2
	KNM(1)=KNM(1)+2
	END